perm filename SAIBRK.FAI[S,AIL] blob
sn#191950 filedate 1975-12-15 generic text, type T, neo UTF8
SEARCH HDRFIL
COMPIL(BRK,<BREAKSET,SETBREAK,STDBRK,GETBREAK,RELBREAK>
,<SAVE,RESTR,BRKMSK,BKTCHK,SIMIO,GOGTAB,X22,X33,OPEN,LOOKUP,ARRYIN,RELEASE,.SKIP.,X11,CORGET,CORREL>
,<BREAKSET, SETBREAK, STDBRK ROUTINES>)
HERE(BREAKSET)
PUSHJ P,SAVE ;SAVE ACS AND THINGS
MOVE LPSA,X33
SUB SP,X22
MOVE X,-2(P) ;TABLE #
MOVSI TEMP,-1 ;GET BLOCK IF NOT THERE, NO NEED TO INIT
PUSHJ P,BKTCHK ;CHECK OUT TABLE #
JRST RESTR ;ERROR RETURN
MOVE B,BRKMSK(CHNL) ;BITS FOR THIS TABLE
IORM B,BKJFFO(CDB) ;MARK THIS TABLE RESERVED & INIT'ED
HLLZS B ;LEFT HALF ONLY
ADD CHNL,CDB ;RELOCATE RANGE 1-18
MOVE C,[ANDCAM B,(D)] ;USUAL CLEARING INSTR
LDB X,[POINT 4,-1(P),35] ;COMMAND
TRZN X,10 ;LEFT OR RIGHT HALF OF TABLE?
SKIPA X,BKCOM(X) ;RIGHT HALF
HLRZ X,BKCOM(X) ;LEFT HALF
JRST (X) ;DISPATCH
BKCOM: XWD XCLUDE,PASLINS ;X,,P
XWD INCL,PENDCH ;I,,A
XWD ILLSET,RETCH ;-,,R
XWD UCASE,SKIPCH ;K,,S
XWD BRKLIN,RESTR ;L,,D
XWD ILLSET,ERMAN ;-,,E
XWD NOLINS,LCASE ;N,,F
XWD OMIT,ILLSET ;O,,-
ILLSET: ERR <ILLEGAL COMMAND TO BREAKSET>,1
JRST RESTR
XCLUDE: MOVE C,[IORM B,(D)] ;EXCLUSION MEANS YOU FIRST SET TO ONE
JRST INCL ;GO DO IT
OMIT: MOVSS B ;OMIT HAS BIT IN RH
HRRZ A,1(SP) ;SET BIT ONLY IF HAVE SOME OMIT CHARS
IORM B,BRKOMT(CDB) ;ASSUME HAVE SOME
CAIN A,0 ;HAVE ANY
ANDCAM B,BRKOMT(CDB) ;NO
INCL: MOVSI D,-200
HRRI D,BRKTBL(CDB) ;RELOCATABLE IOWD
BRKLUP: XCT C ;CLEAR (OR SET) PROPER (HALF OF PROPER) TABLE
AOBJN D,BRKLUP
MOVE C,[IORM B,BRKTBL(D)] ;USUAL SETTING INSTR
CAIN X,XCLUDE ;BY EXCEPTION?
MOVE C,[ANDCAM B,BRKTBL(D)] ;YES, WANT TO TURN OFF BITS
ADDI C,(CDB) ;RELOCATE IT
HRRZ A,1(SP) ;LENGTH OF STRING
MOVE X,2(SP) ;BYTE POINTER
JRST BRKL2
BRKL1: ILDB D,X ;GET A CHAR
XCT C ;DO RIGHT THING TO RIGHT BIT
BRKL2: SOJGE A,BRKL1
JRST RESTR
PASLINS: TDZA B,B ;PASS LINE NOS. SINE COMMENT
NOLINS: MOVEI B,-1 ;INFORM IN THAT IT SHOULD
MOVEM B,LINTBL(CHNL) ; DELETE LINE NOS.
JRST RESTR
BRKLIN: SKIPA B,[-1] ;MARK BREAK ON LINE NOS. FOR THIS TBL
ERMAN: MOVSI B,-1 ;LH NEG SIGNALS ERMAN'S SCHEME
MOVEM B,LINTBL(CHNL)
JRST RESTR
PENDCH: SETOM DSPTBL(CHNL) ;APPEND TO END OF INPUT
JRST RESTR
SKIPCH: TDZA B,B ;CHAR NEVER APPEARS IN INPUT STRING
RETCH: MOVEI B,-1 ;RETAIN FOR NEXT TIME
MOVEM B,DSPTBL(CHNL)
JRST RESTR
UCASE: MOVSS B ;INTO RIGHT HLF
IORM B,BRKCVT(CDB)
JRST RESTR
LCASE: MOVSS B
ANDCAM B,BRKCVT(CDB)
JRST RESTR
HERE (SETBREAK)
HRRZ TEMP,-3(SP) ;DO OMIT STRING, IF PRESENT
JUMPE TEMP,NO.O ;NULL STRING DOESN'T COUNT
PUSH P,-1(P) ;TABLE #
PUSH SP,-3(SP) ;OMIT CHARACTERS
PUSH SP,-3(SP)
PUSH P,["O"] ;OMIT!
PUSHJ P,BREAKSET ;DO THAT
NO.O: HRRZS -1(SP) ;COUNT OF # OF COMMANDS
BKSLUP: SOSGE -1(SP) ;DONE?
JRST BKSDUN ; YES
PUSH P,-1(P) ;TABLE #
ILDB TEMP,(SP) ;COMMAND
PUSH P,TEMP
PUSH SP,-5(SP)
PUSH SP,-5(SP) ;STRING TO USE IF NECESSARY
PUSHJ P,BREAKSET
JRST BKSLUP ;DO IT -- AGAIN
BKSDUN: SUB P,X22
SUB SP,[XWD 6,6]
JRST @2(P)
HERE (STDBRK)
PUSH P,-1(P) ;CHANNEL
PUSH SP,STDBDV
PUSH SP,STDBDV+1
PUSH P,[14] ;MODE 14
PUSH P,[2] ;INPUT BUFFERS
PUSH P,[0] ;OUTPUT BUFFERS
PUSH P,[0] ;COUNT
PUSH P,[0] ;BRCHAR
PUSH P,[.SKIP.] ;EOF
SETZM .SKIP.
PUSHJ P,OPEN ;OPEN CHANNEL
SKIPE .SKIP. ;ERROR?
ERR <Can't open STDBRK channel>,1,STDEXT
PUSH P,-1(P)
PUSH SP,STDBFL
PUSH SP,STDBFL+1
PUSH P,[.SKIP.]
SETZM .SKIP.
PUSHJ P,LOOKUP
SKIPE .SKIP.
ERR <Can't lookup STDBRK file>,1,STDEXT
PUSH P,-1(P) ;CHANNEL
MOVE USER,GOGTAB
MOVEI X,1 ;ORDINARY USER TABLE #
SKIPE BKTPRV(USER) ;PRIVILEGED?
MOVEI X,0 ;YES
MOVSI TEMP,-1 ;GET BLOCK IF NOT THERE, NO NEED TO INIT
PUSHJ P,BKTCHK ;CHECK OUT SITUATION
JRST STDEXT ;ERROR OF SOME SORE
PUSH P,CDB ;WHERE TO PUT IT
PUSH P,[BRKDUM] ;HOW MUCH TO READ
PUSHJ P,ARRYIN ;READ IN ARRAY
PUSH P,-1(P) ;CHANNEL
PUSH P,[0] ;CLOSE INHIBIT
PUSHJ P,RELEASE ;RELEASE THE FILE
STDEXT:
SUB P,X22 ;CLEAR STACK
JRST @2(P)
NOTENX<
STDBFL:
BKTFIL
STDBDV: =3
POINT 7,[ASCIZ/SYS/]
>;NOTENX
TENX<
STDBFL:
BKTFIL ;DEFINED IN HEAD
STDBDV: =3
POINT 7,[ASCIZ/DSK/],-1
>;TENX
HERE (GETBREAK)
PUSHJ P,SAVE
SKIPN BKTPRV(USER) ;PRIVILEGED?
JRST GTBK03 ;NO
MOVSI D,-4 ;YES, SEARCH ALL 4 GROPS
HRRI D,BKTPTR(USER) ;START AT FIRST GROUP
SETZ A, ;INITIALIZE RESULT
JRST GTBK04
GTBK03: MOVSI D,-3 ;ORDINARY USER, SEARCH LAST 3
HRRI D,BKTPTR+1(USER)
MOVEI A,=18 ;INITIALIZE RESULT
GTBK04:
SETZ C, ;INITIAL RESULT
GTBK02: SKIPN CDB,(D) ;POINTER TO GROUP OF 18 TABLES
JRST GTBK18 ;NO POINTER, SO WHOLE BLOCK OF 18 FREE
SETCM B,BKJFFO(CDB) ;GET RESERVATION WORD
JUMPE B,GTBK01 ;JUMP IF ALL 18 ARE RESERVED AND INIT'ED
JFFO B,.+1 ;FIND FIRST UNRESERVED TABLE
CAILE C,=17 ;CHECK ONLY RESERVATIONS, NOT INIT'S
JRST GTBK01 ;ALL 18 RESERVED
ADD A,C ;FOUND ONE
ADDI C,1
GTBKRT: HLLZ B,BRKMSK(C) ;RESERVE THIS TABLE
IORM B,BKJFFO(CDB)
MOVSS B ;BIT INTO RIGHT HALF
ANDCAM B,BKJFFO(CDB) ;NOT INIT'ED
ANDCAM B,BRKCVT(CDB)
ANDCAM B,BRKOMT(CDB)
ADDI C,(CDB) ;RELOCATE 1 TO 18
SETZM LINTBL(C)
SETZM DSPTBL(C)
MOVEI CDB,BRKTBL(CDB) ;FWA OF CHAR TAB
HRLI CDB,-200 ;AOBJN COUNT
HRLI B,(B) ;BIT IN EACH HALF
ANDCAM B,(CDB) ;ZAP!
AOBJN CDB,.-1
GTBKF2: SUBI A,=17 ;ADJUST FOR INITIAL OFFSET
MOVEM A,RACS+A(USER) ;RESULT
MOVE LPSA,X11
JRST RESTR ;DONE
GTBK01: ADDI A,=18
AOBJN D,GTBK02 ;TRY NEXT GROUP OF 18
GTBKF: MOVNI A,1 ;FAILURE
JRST GTBKF2
GTBK18: MOVE X,A ;TABLE NUMBER
SUBI X,=17 ;CORRECT
MOVSI TEMP,-1 ;CALL CORGET, NO INIT CHECK
PUSHJ P,BKTCHK
JRST GTBKF ;ERROR RETURN
MOVE C,CHNL
JRST GTBKRT
HERE (RELBREAK)
PUSHJ P,SAVE
RLBK01: MOVE X,-1(P) ;TABLE #
ADDI X,=17 ;NEG TAB NUMS FOR PRIV USERS CAUSE PROBS
SKIPN BKTPRV(USER) ;PRIVILEGED?
CAIL X,=18 ;LOWEST FOR ORDINARY USER
CAILE X,=71 ;MAX FOR EVERYBODY
JRST RLBKRT ;RELEASE ALWAYS WORKS
IDIVI X,=18
MOVEI A,1(Y) ;A NOW IN RANGE 1 TO 18
ADD X,USER ;RELOCATE GROUP NUMBER
SKIPN B,BKTPTR(X) ;B GETS POINTER TO CORRECT GROUP OF TABLES
JRST RLBKRT ;NON-FATAL ERROR
MOVE TEMP,BRKMSK(A) ;BITS FOR THE TABLE
ANDCAB TEMP,BKJFFO(B) ;UNRESERVE
JUMPN TEMP,RLBKRT ;IF STILL SOME RESERVED
SETZM BKTPTR(X) ;THIS GROUP DEFUNCT
PUSHJ P,CORREL ;RELEASE BLOCK POINTED TO BY B
RLBKRT: MOVE LPSA,X22
JRST RESTR
ENDCOM(BRK)
END